home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / tf_sourc / testvesa.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-06-16  |  6.8 KB  |  191 lines
  1. PROGRAM TestVESA;   { by »The Faker« in 1993 }
  2. USES
  3.     Crt;
  4. TYPE
  5.     String0=ARRAY[0..65534] OF Char;
  6.     String0Ptr=^String0;
  7.     VESABlock=RECORD
  8.                     VESASignature:ARRAY[0..3] OF Char;
  9.                     VESAVersion:Word;
  10.                     OEMStringPtr:String0Ptr;
  11.                     Capabilities:ARRAY[0..3] OF Byte;
  12.                     VideoModePtr:String0Ptr;
  13.               END;
  14.     ModeBlock=RECORD
  15.                     ModeAttr:Word;
  16.                     WinAAttr:Byte;
  17.                     WinBAttr:Byte;
  18.                     WinGranularity:Word;
  19.                     WinSize:Word;
  20.                     WinASegment:Word;
  21.                     WinBSegment:Word;
  22.                     WinFuncPtr:Pointer;
  23.                     BytesPerScanLine:Word;
  24.                     XRes:Word;
  25.                     YRes:Word;
  26.                     XCharSize:Byte;
  27.                     YCharSize:Byte;
  28.                     NumberOfPlanes:Byte;
  29.                     BitsPerPixel:Byte;
  30.                     NumberOfBanks:Byte;
  31.                     MemoryModel:Byte;
  32.                     BankSize:Byte;
  33.               END;
  34. VAR
  35.    Block:^VESABlock;
  36.    Status:Word;
  37.    Mode:ARRAY[0..255] OF RECORD
  38.                                Nr:Word;
  39.                                Info:^ModeBlock;
  40.                          END;
  41.    Modes:Byte;
  42.  
  43. PROCEDURE WriteStr0(S:String0Ptr);
  44. VAR
  45.    I:Byte;
  46. BEGIN
  47.      I:=0;
  48.      WHILE S^[I]<>#0 DO
  49.      BEGIN
  50.           Write(S^[I]);
  51.           Inc(I);
  52.      END;
  53.      WriteLn;
  54.      WriteLn;
  55. END;
  56.  
  57. FUNCTION Hex(B:Byte):String;
  58. CONST
  59.      HexTable:ARRAY[0..15] OF Char=('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  60. BEGIN
  61.      Hex:=HexTable[B SHR 4]+HexTable[B AND 15];
  62. END;
  63.  
  64. PROCEDURE WriteList(S:String0Ptr);
  65. VAR
  66.    I:Byte;
  67.    P:Pointer;
  68.    ModeNr:Word;
  69. BEGIN
  70.      I:=0;
  71.      Modes:=0;
  72.      WHILE Ord(S^[I])+Ord(S^[I+1]) SHL 8<>$FFFF DO
  73.      BEGIN
  74.           ClrScr;
  75.           ModeNr:=Ord(S^[I])+Ord(S^[I+1]) SHL 8;
  76.           Mode[Modes].Nr:=ModeNr;
  77.           GetMem(Mode[Modes].Info,256);
  78.           P:=Mode[Modes].Info;
  79.           ASM
  80.              les di,p
  81.              mov cx,modenr
  82.              mov ax,$4f01
  83.              int $10
  84.           END;
  85.           WriteLn('Mode Nr: ',Hex(Ord(S^[I+1])),Hex(Ord(S^[I])));
  86.           WriteLn('Mode Information:');
  87.           WITH Mode[Modes].Info^ DO
  88.           BEGIN
  89.                IF ModeAttr AND 1=1 THEN
  90.                   WriteLn('Mode can be initialled in present video configuration.')
  91.                ELSE WriteLn('Mode can not be initialled in present video configuration.');
  92.                IF ModeAttr AND 2=2 THEN
  93.                   WriteLn('Extended Mode Information is available, as seen below.')
  94.                ELSE WriteLn('Extended Mode Information is not available, as seen below.');
  95.                IF ModeAttr AND 4=4 THEN
  96.                   WriteLn('BIOS support for output functions.')
  97.                ELSE WriteLn('No BIOS support for output functions.');
  98.                IF ModeAttr AND 8=8 THEN
  99.                   Write('Mode is a color')
  100.                ELSE Write('Mode is a monochrome');
  101.                IF ModeAttr AND 16=16 THEN
  102.                   WriteLn(' graphics mode.')
  103.                ELSE WriteLn(' text mode.');
  104.                WriteLn;
  105.                WriteLn('The granularity of a window is ',WinGranularity,' KBytes.');
  106.                WriteLn('The size of a window is ',WinSize,' KBytes.');
  107.                IF WinAAttr AND 1=1 THEN
  108.                BEGIN
  109.                     IF WinAAttr AND 2=2 THEN
  110.                        WriteLn('Window A is readable.')
  111.                     ELSE WriteLn('Window A is not readable.');
  112.                     IF WinAAttr AND 4=4 THEN
  113.                        WriteLn('Window A is writeable.')
  114.                     ELSE WriteLn('Window A is not writeable.');
  115.                     WriteLn('Window A is located at ',Hex(Hi(WinASegment)),Hex(Lo(WinASegment)),'hex in host address space.');
  116.                END
  117.                ELSE WriteLn('Window A is not supported.');
  118.                WriteLn;
  119.                IF WinBAttr AND 1=1 THEN
  120.                BEGIN
  121.                     IF WinBAttr AND 2=2 THEN
  122.                        WriteLn('Window B is readable.')
  123.                     ELSE WriteLn('Window B is not readable.');
  124.                     IF WinBAttr AND 4=4 THEN
  125.                        WriteLn('Window B is writeable.')
  126.                     ELSE WriteLn('Window B is not writeable.');
  127.                     WriteLn('Window B is located at ',Hex(Hi(WinASegment)),Hex(Lo(WinASegment)),'hex in host address space.');
  128.                END
  129.                ELSE WriteLn('Window B is not supported.');
  130.                IF WinFuncPtr<>NIL THEN
  131.                   WriteLn('Windowing procedure exists.')
  132.                ELSE WriteLn('Windowing procedure does not exist.');
  133.                WriteLn;
  134.                WriteLn('Bytes per scan line: ',BytesPerScanLine);
  135.                IF ModeAttr AND 2=2 THEN
  136.                BEGIN
  137.                     WriteLn('Resolution: ',XRes,' x ',YRes);
  138.                     WriteLn('Character cell: ',XCharSize,' x ',YCharSize);
  139.                     WriteLn('Number of memory planes: ',NumberOfPlanes,'.');
  140.                     WriteLn('Bits per pixel: ',BitsPerPixel,'.');
  141.                     WriteLn('Number of Banks: ',NumberOfBanks,'.');
  142.                     Write('Memory model: ');
  143.                     CASE MemoryModel OF
  144.                          0:WriteLn('Text mode.');
  145.                          1:WriteLn('CGA mode.');
  146.                          2:WriteLn('Hercules mode.');
  147.                          3:WriteLn('4 plane planar mode.');
  148.                          4:WriteLn('Packed pixel mode.');
  149.                          5:WriteLn('Non-chain 4, 256 color mode.');
  150.                          6:WriteLn('Hi-Color / True-Color mode.');
  151.                          7..15:WriteLn('Not defined yet by the VESA standard. Nr=',MemoryModel);
  152.                          16..255:WriteLn('Special mode of the chip or card.');
  153.                     END;
  154.                     WriteLn('Bank size: ',BankSize,' KBytes.');
  155.                END;
  156.           END;
  157.           ReadLn;
  158.           Inc(I,2);
  159.           Inc(Modes);
  160.      END;
  161. END;
  162.  
  163. BEGIN
  164.      ClrScr;
  165.      GetMem(Block,256);
  166.      ASM
  167.         mov di,word ptr block
  168.         mov es,word ptr block+2
  169.         mov ax,$4f00
  170.         int $10
  171.         mov status,ax
  172.      END;
  173.      IF Status<>$4F THEN
  174.      BEGIN
  175.           WriteLn('VESA BIOS Extension not installed!');
  176.           Halt(1);
  177.      END;
  178.      WITH Block^ DO
  179.      BEGIN
  180.           IF VESASignature<>'VESA' THEN
  181.           BEGIN
  182.                WriteLn('VESA Information Structure Block not identified!');
  183.                Halt(2);
  184.           END;
  185.           WriteLn('VESA Version: ',Hi(VESAVersion),'.',Lo(VESAVersion));
  186.           WriteStr0(OEMStringPtr);
  187.           ReadLn;
  188.           WriteList(VideoModePtr);
  189.      END;
  190. END.
  191.